home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / linda-base.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  4KB  |  120 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;                                                                           ;;
  9. ;;   EuLisp Module  -   Copyright (C) Codemist and University of Bath 1989   ;;
  10. ;;                                                                           ;;
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ;;                                                                           ;;
  15. ;; Name: linda-base                                                          ;;
  16. ;;                                                                           ;;
  17. ;; Author: Keith Playford                                                    ;;
  18. ;;                                                                           ;;
  19. ;; Date: 31 May 1990                                                         ;;
  20. ;;                                                                           ;;
  21. ;; Description: Basic linda bits and peices for tuples                       ;;
  22. ;;                                                                           ;;
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24.  
  25. ;;
  26.  
  27. ;; Change Log:
  28. ;;   Version 1.0 (31/5/90)
  29.  
  30. ;;
  31.  
  32. (defmodule linda-base
  33.  
  34.   (lists
  35.    list-operators
  36.    extras
  37.    arith
  38.    classes
  39.    streams
  40.    ccc
  41.    others
  42.    tables
  43.    vectors) ()
  44.  
  45.   (deflocal *vector-size* 5)
  46.  
  47.   (deflocal *linda-wild-card* 'linda-match-all)
  48.  
  49.   (export *vector-size* *linda-wild-card*)
  50.  
  51.   ;;
  52.  
  53.   ;; Note:
  54.  
  55.   ;;   Just a hack to begin with - going for an eq on name and equal on 
  56.   ;;   everything else to fit in with Dave's world of tuple vectors.
  57.  
  58.   ;;
  59.  
  60.   ;; Linda base object...
  61.  
  62.   (defstruct linda-object () ())
  63.  
  64.   (export linda-object)
  65.  
  66.   ;; Tuple structure...
  67.  
  68.   (defstruct linda-tuple linda-object
  69.     ((key initargs (key)
  70.       accessor linda-tuple-key)
  71.      (fields initargs (fields)
  72.          accessor linda-tuple-fields))
  73.     constructor make-linda-tuple)
  74.  
  75.   (export linda-tuple linda-tuple-key linda-tuple-fields make-linda-tuple)
  76.  
  77.   ;; Match checker...
  78.  
  79.   (defun linda-tuple-matched-p (pattern tuple)
  80.     (if (eq (linda-tuple-key pattern) (linda-tuple-key tuple))
  81.       ;; Field search...
  82.       (match-fields (linda-tuple-fields pattern)
  83.             (linda-tuple-fields tuple))
  84.       nil))
  85.  
  86.   (export linda-tuple-matched-p)
  87.  
  88.   (defun match-fields (pf tf)
  89.     (match-fields-aux pf tf (vector-length pf)))
  90.  
  91.   (defun match-fields-aux (pf tf n)
  92.     (cond 
  93.       ((= n 0) t)
  94.       ((match-field (vector-ref pf (- n 1)) (vector-ref tf (- n 1))) 
  95.          (match-fields-aux pf tf (- n 1)))
  96.       (t nil)))
  97.  
  98.   (defun match-field (f1 f2) ;; f1 pattern...
  99.     (cond 
  100.       ((or (eq f1 *linda-wild-card*) (eq f2 *linda-wild-card*)) t)
  101.       ((equal f1 f2) t)
  102.       (t nil)))
  103.  
  104.   (defmacro tuple (name . rest)
  105.     `(make-linda-tuple 
  106.        'key ,name
  107.        'fields (let ((\@v\@ (make-vector *vector-size* *linda-wild-card*)))
  108.          ,@(make-tuple-filler rest 0)
  109.          \@v\@)))
  110.  
  111.   (defun make-tuple-filler (ll n)
  112.     (if (null ll) nil
  113.       (cons `((setter vector-ref) \@v\@ ,n ,(car ll))
  114.         (make-tuple-filler (cdr ll) (+ n 1)))))
  115.  
  116.   (export tuple)
  117.  
  118. )
  119.     
  120.